
module MicroInstrucoes where

import Data.IORef ( IORef, newIORef )
import Graphics.UI.GLUT
import CPU (fromInt32)

data State = State { botao, coordx, coordy, eixox, eixoy, eixoz
					, x2, y2, z2, para, menu :: IORef GLint
					, proporcao, escala :: IORef GLfloat
					, porc, veloc, corI :: IORef Double
					, cheios, enchem :: IORef [String]
					, ula, m, instrDesc :: IORef String
					, b, c, programa, progAnt, variaveis :: IORef [Int]
					, mpc, addr, mar, mdr, pc, mbr, sp, lv
					, aparece, tamUFPI, textoI
					, cpp, tos, opc, h, desl, ciclo, isaInstr :: IORef Int}

makeState :: [String] -> IO State
makeState programa = do
	botao' <- newIORef 0
	coordx' <- newIORef 0
	coordy' <- newIORef 0
	veloc' <- newIORef 0.05
	aparece' <- newIORef 0
	tamUFPI' <- newIORef 1
	textoI' <- newIORef 0
	corI' <- newIORef 0
	proporcao' <- newIORef 0
	escala' <- newIORef 1
	x <- newIORef 25
	y <- newIORef 0
	z  <- newIORef 0
	x2' <- newIORef 10
	y2' <- newIORef (-2)
	z2' <- newIORef (-20)
	porc' <- newIORef 0
	para' <- newIORef 1
	ciclo' <- newIORef 0
	menu' <- newIORef 1
	cheios' <- newIORef []
	enchem' <- newIORef ["MPCMem"]
	mpc' <- newIORef 0
	--Programa
	--programa' <- newIORef [2,5,14,16,19,25,2,28,1,33,2]
	--programa' <- newIORef [2,5,14,16,19]
	progAnt' <- newIORef []
	(pilhaProg, pilhaVar) <- geraPilhas programa
	programa' <- newIORef pilhaProg
	variaveis' <- newIORef pilhaVar
	instrDesc' <- newIORef "Main1: PC = PC + 1; fetch; goto (MBR)"
	isaInstr' <- newIORef 0
	--Instrucao
	addr' <- newIORef 0
	ula' <- newIORef ""
	c' <- newIORef [0,0,0,0,0,0,0,0,0]
	m' <- newIORef ""
	b' <- newIORef [0,0,0,0]
	-- Registradores
	mar' <- newIORef 0
	mdr' <- newIORef 0
	pc' <- newIORef 0
	mbr' <- newIORef 0
	sp' <- newIORef (length pilhaVar)
	lv' <- newIORef 0
	cpp' <- newIORef 0
	tos' <- newIORef (if ((length pilhaVar)==0) then 0 else (head pilhaVar))
	opc' <- newIORef 0
	h' <- newIORef 0
	desl' <- newIORef 0
	return $ State { botao = botao', coordx = coordx', coordy = coordy'
					, eixox = x, eixoy = y, eixoz = z, x2 = x2', y2 = y2', z2 = z2'
					, para = para', ciclo = ciclo', menu = menu', porc = porc'
					, cheios = cheios', enchem = enchem', ula = ula', mpc = mpc'
					, b = b', c = c', m = m', addr = addr', mar = mar', mdr = mdr'
					, pc = pc', mbr = mbr', sp = sp', lv = lv', cpp = cpp', tos = tos'
					, opc = opc', h = h', desl = desl', programa = programa'
					, instrDesc = instrDesc', variaveis = variaveis', progAnt = progAnt'
					, isaInstr = isaInstr', veloc = veloc', aparece = aparece'
					, tamUFPI = tamUFPI', textoI = textoI', corI = corI'
					, proporcao = proporcao', escala = escala'}

geraPilhas :: [String] -> IO ([Int],[Int])
geraPilhas [] = return ([2,5,14,16,19], [3,1,5,12,47,68])
geraPilhas (a:x) = do
					fonte <- readFile a
					return (geraProg fonte,[])

geraProg :: String -> [Int]
geraProg [] = []
geraProg (a:x) = geraID (pegaComando (a:x)) : (geraProg (tiraComando (a:x)))

geraID :: String -> Int
geraID [] = 0
geraID x
	| x == "add" = 2
	| x == "sub" = 5
	| x == "and" = 8
	| x == "or" = 11
	| x == "dup" = 14
	| x == "pop" = 16
	| x == "swap "= 19
	| x == "bipush" = 25
	| x == "iload" = 28
	| x == "istore" = 33
	| x == "wide" = 39
	| x == "wide_iload" = 124
	| x == "wide_istore" = 101
	| x == "ldc_w" = 40
	| x == "iinc" = 44
	| x == "goto" = 50
	| x == "iflt" = 56
	| x == "ifeq" = 60
	| x == "if_icmpeq" = 64
	| x == "t" = 70
	| x == "f" = 71
	| x == "invokevirtual" = 130
	| x == "ireturn" = 152
	| otherwise = read x

pegaComando :: String -> String
pegaComando [] = []
pegaComando (a:x)
	| elem a [' ','\t','\n','\v','\f','\r','\160'] = []
	| otherwise = a : pegaComando x

tiraComando :: String -> String
tiraComando [] = []
tiraComando (a:x)
	| elem a [' ','\t','\n','\v','\f','\r','\160'] = x
	| otherwise = tiraComando x

geraInstrIsa :: Int -> Int
geraInstrIsa x
	| elem x [0] = 0
	| elem x [1] = 1
	| elem x [2,3,4] = 2
	| elem x [5,6,7] = 3
	| elem x [8,9,10] = 4
	| elem x [11,12,13] = 5
	| elem x [14,15] = 6
	| elem x [16,17,18] = 7
	| elem x [19,20,21,22,23,24] = 8
	| elem x [25,26,27] = 9
	| elem x [28,29,30,31,32] = 10
	| elem x [33,34,35,36,37,38] = 11
	| elem x [39] = 12
	| elem x [124,125,126,127] = 13
	| elem x [101,102,103,104] = 14
	| elem x [40,41,42,43] = 15
	| elem x [44,45,46,47,48,49] = 16
	| elem x [50,51,52,53,54,55] = 17
	| elem x [56,57,58,59] = 18
	| elem x [60,61,62,63] = 19
	| elem x [64,65,66,67,68,69] = 20
	| elem x [70] = 21
	| elem x [71,72,73] = 22
	| elem x [130,131,132,133,134,135,136,137,138,139,140,141,142
			 ,143,144,145,146,147,148,149,150,151] = 23
	| elem x [152,153,154,155,156,157,158,159] = 24
	| otherwise = 0

passaCiclo :: Int -> State -> IO ()
passaCiclo ciclo state
	| ciclo == 0 = do
					m' <- get (m state)					
					enchem state $= ["MPCMem"]
					cheios state $= []
					microInstr 5
					ula state $= ""
					mpc' <- get (mpc state)
					isaInstr state $= geraInstrIsa mpc'
	| ciclo == 1 = do					
					enchem state $= ["MMIR"]					
					microInstr 1					
	| ciclo == 2 = do
					c' <- get (c state)
					m' <- get (m state)
					enchem state $=
						["Addr", "MUla", "MDesl", "BDec"] ++ 
						instrMem m' ++
						["MBRend", "J1", "J2"] ++
						(assocAt c' ["attMAR", "attMDR", "attPC", "attSP", "attLV"
								, "attCPP", "attTOS", "attOPC", "attH"])					
	| ciclo == 3 = do
					b' <- get (b state)					
					enchem state $= assocAt (decoder4x16 b') ["atMDR", "atPC", "atMBR1", "atMBR2"
								, "atSP", "atLV", "atCPP", "atTOS", "atOPC"]
					microInstr 2
	| ciclo == 4 = do
					b' <- get (b state)
					enchem state $= assocAt (decoder4x16 b') ["MDRB", "PCB", "MBRB1", "MBRB2"
								, "SPB", "LVB", "CPPB", "TOSB", "OPCB"]
	| ciclo == 5 = enchem state $= ["B","HULA"] 
	| ciclo == 6 = enchem state $= ["ULADesl","ULAN", "ULAZ"]
	| ciclo == 7 = do
					m' <- get (m state)
					enchem state $= ["C","NBIT", "ZBIT"] ++ instrMem ("v"++m')
					microInstr 3
	| ciclo == 8 = do	
					c' <- get (c state)
					enchem state $= assocAt c' ["CMAR", "CMDR", "CPC", "CSP", "CLV", "CCPP"
								, "CTOS", "COPC", "CH"]
					m' <- get (m state)
					programa' <- get (programa state)
					variaveis' <- get (variaveis state)
					if (m' == "fetch") then novoMbr programa' state 
					 else if (m' == "read") then novoMdr variaveis' state
					 else if (m' == "write") then escreveMdr state					 
					 else if (m' == "fetchwrite") then fetchWrite programa' state
					 else if (m' == "readfetch") then readFetch programa' variaveis' state else return ()
	| ciclo == 9 = do
					microInstr 4
					m' <- get (m state)					
					enchem state $= ["MPCFim", "MPCCab"] ++ instrMem ("i"++m')
		where
			microInstr :: Int -> IO ()
			microInstr x = do
							mpc' <- get (mpc state)
							microinstrucao mpc' state x

fetchWrite :: [Int] -> State -> IO ()
fetchWrite programa state = do
								novoMbr programa state
								escreveMdr state 
								
readFetch :: [Int] -> [Int] -> State -> IO ()
readFetch programa variaveis state = do
								novoMbr programa state
								novoMdr variaveis state

instrMem :: String -> [String]
instrMem m	
	| m == "fetch"  = ["MMemF"]
	| (m == "read") ||(m == "write")  = ["MMem"]
	| m == "ifetch" = ["PCMem"]
	| (m == "iread") ||(m == "iwrite")  = ["MARMem"]
	| m == "vfetch" = ["MBRMem"]
	| m == "vread"  = ["MDRMem2"]
	| m == "vwrite" = ["MDRMem1"]
	| m == "fetchwrite" = ["MMemF", "MMem"]
	| m == "ifetchwrite" = ["PCMem", "MARMem"]
	| m == "vfetchwrite" = ["MBRMem", "MDRMem1"]
	| m == "readfetch" = ["MMem", "MMemF"]
	| m == "ireadfetch" = ["MARMem", "PCMem"]
	| m == "vreadfetch" = ["MDRMem2", "MBRMem"]
	| otherwise = []

novoMbr :: [Int] -> State -> IO ()
novoMbr [] state = mbr state $= 0
novoMbr (a:x) state = do
						mbr state $= a
						programa state $= x
						progAnt' <- get (progAnt state)
						progAnt state $= a : progAnt'

novoMdr :: [Int] -> State -> IO ()
novoMdr [] state = mdr state $= 0
novoMdr (a:x) state = do
						mar' <- get (mar state)
						mdr state $= (a:x) !! ((length (a:x)) - mar')						
						retiraLista ((length (a:x)) - mar') (a:x) state

retiraLista :: Int -> [Int] -> State -> IO ()
retiraLista 0 lista state = variaveis state $= lista
retiraLista qtde [] state = variaveis state $= []
retiraLista qtde (a:x) state 
	| qtde > 1 = variaveis state $= (a:x)
	| otherwise = retiraLista (qtde - 1) x state

escreveMdr :: State -> IO ()
escreveMdr state = do
					mdr' <- get (mdr state)
					mar' <- get (mar state)
					variaveis' <- get (variaveis state)
					atualizaValor ((length variaveis') - mar') mdr' variaveis' state
					
atualizaValor :: Int -> Int -> [Int] -> State -> IO ()
atualizaValor posicao valor lista state
	| posicao < 0 = variaveis state $= valor : lista
	| otherwise   = variaveis state $= insereLista posicao valor lista

insereLista :: Int -> Int -> [Int] -> [Int]
insereLista _ valor [] = [valor]
insereLista 0 valor (a:x) = valor : x
insereLista p valor (a:x) = a : insereLista (p - 1) valor x

assocAt :: [Int] -> [String] -> [String]
assocAt _ [] = []
assocAt [] _ = []
assocAt (a:x) (b:y) 
	| a == 1 = b : assocAt x y
	| otherwise = assocAt x y

microinstruc :: ([Int],String,[Int],String,String) -> State -> Int -> Int -> IO ()
microinstruc (b',m',c',descr',ula') state prox parte
	| parte == 1 = do				
				b state $= b'				
				c state $= c'
				instrDesc state $= descr'				
	| parte == 2 = do
				ula state $= ula'
	| parte == 3 = do				
				operando' <- operando (decoder4x16 b') state
				h' <- get (h state)
				ula' <- get (ula state)				
				desl state $= operUla h' operando' ula'
	| parte == 4 = do
				m state $= m'				
				desl' <- get (desl state)
				atualizaC 0 desl' c' state
	| parte == 5 = do
				mpc' <- get (mpc state)
				if (mpc' == 0) then do
						mbr' <- get (mbr state)
						mpc state $= mbr'
					else mpc state $= prox

atualizaC :: Int -> Int -> [Int] -> State -> IO ()
atualizaC 9 _ _ _ = return ()
atualizaC ini valor (a:x) state 
	| (ini == 0) && (a == 1) = do
								mar state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 1) && (a == 1) = do
								mdr state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 2) && (a == 1) = do
								pc state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 3) && (a == 1) = do
								sp state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 4) && (a == 1) = do
								lv state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 5) && (a == 1) = do
								cpp state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 6) && (a == 1) = do
								tos state $= valor
								atualizaC (ini + 1) valor x state
	| (ini == 7) && (a == 1) = do
								opc state $= valor
								atualizaC (ini + 1) valor x state	
	| (ini == 8) && (a == 1) = do
								h state $= valor
								atualizaC (ini + 1) valor x state
	| otherwise = atualizaC (ini + 1) valor x state

operUla :: Int -> Int -> String -> Int
operUla h valor oper
	| oper == "inc"  = valor + 1
	| oper == "dec"  = valor - 1
	| oper == "add"  = valor + h
	| oper == "sub"  = valor - h
	| oper == "ad+1" = valor + h + 1
	| oper == "and"  = toInt32 0 (andB (map (== 1) (fromInt32 0 valor)) (map (== 1) (fromInt32 0 h)))
	| oper == "or"   = toInt32 0 (orB (map (== 1) (fromInt32 0 valor)) (map (== 1) (fromInt32 0 h)))
	| oper == " B"   = valor
	| oper == " H"   = h
	| oper == "desl" = toInt32 0 (desloca8 0 (fromInt32 0 valor))
	| otherwise = valor

operando :: [Int] -> State -> IO Int
operando (b1:b2:b3:b4:b5:b6:b7:b8:b9:x) state
	| b1 == 1 = do 
					x <- get (mdr state)
					return (x)
	| b2 == 1 = do 
					x <- get (pc state)
					return (x)
	| b3 == 1 = do 
					x <- get (mbr state)
					-- estende o sinal
					return (estendeSinal x)
	| b4 == 1 = do 
					x <- get (mbr state)
					-- valor dos 8 bits
					return (x)
	| b5 == 1 = do 
					x <- get (sp state)
					return (x)
	| b6 == 1 = do 
					x <- get (lv state)
					return (x)
	| b7 == 1 = do 
					x <- get (cpp state)
					return (x)
	| b8 == 1 = do 
					x <- get (tos state)
					return (x)
	| otherwise = do
					x <- get (opc state)
					return (x)

microinstrucao :: Int -> State -> Int -> IO ()
microinstrucao x state parte
	-- Main1: MBR armazena o codigo de operacao; obtencao do proximo byte; decodificacao da instrucao
	| x == 0 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"Main1: PC = PC + 1; fetch; goto (MBR)","inc") state 0 parte	
	-- nop1: Nao faz nada
	| x == 1 = microinstruc ([1,1,1,1],"",[0,0,0,0,0,0,0,0,0]
							,"nop1: goto Main1","") state 0 parte	
	-- iadd1: Leitura do valor a ser colocado no topo da pilha
	| x == 2 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"iadd1: MAR = SP = SP - 1; rd","dec") state 3 parte	
	-- iadd2: H = Topo da pilha
	| x == 3 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"iadd2: H = TOS"," B") state 4 parte
	-- iadd3: Soma das 2 palavras dp topo da pilha; resultado armazenado no topo da pilha
	| x == 4 = microinstruc ([0,0,0,0],"write",[0,1,0,0,0,0,1,0,0]
							,"iadd3: MDR = TOS = MDR + H; wr; goto Main1","add") state 0 parte
	-- isub1: Leitura do valor a ser colocado no topo da pilha
	| x == 5 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"isub1: MAR = SP = SP - 1; rd","dec") state 6 parte	
	-- isub2: H = Topo da pilha
	| x == 6 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"isub2: H = TOS"," B") state 7 parte
	-- isub3: Subtracao das 2 palavras dp topo da pilha; resultado armazenado no topo da pilha
	| x == 7 = microinstruc ([0,0,0,0],"write",[0,1,0,0,0,0,1,0,0]
							,"isub3: MDR = TOS = MDR - H; wr; goto Main1","sub") state 0 parte
	-- iand1: Leitura do valor a ser colocado no topo da pilha
	| x == 8 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"iand1: MAR = SP = SP - 1; rd","dec") state 9 parte
	-- iand2: H = Topo da pilha
	| x == 9 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"iand2: H = TOS"," B") state 10 parte
	-- iand3: AND das 2 palavras dp topo da pilha; resultado armazenado no topo da pilha
	| x == 10 = microinstruc ([0,0,0,0],"write",[0,1,0,0,0,0,1,0,0]
							,"iand3: MDR = TOS = MDR AND H; wr; goto Main1","and") state 0 parte	
	-- ior1: Leitura do valor a ser colocado no topo da pilha
	| x == 11 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"ior1: MAR = SP = SP - 1; rd","dec") state 12 parte
	-- ior2: H = Topo da pilha
	| x == 12 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"ior2: H = TOS"," B") state 13 parte
	-- ior3: OR das 2 palavras dp topo da pilha; resultado armazenado no topo da pilha
	| x == 13 = microinstruc ([0,0,0,0],"write",[0,1,0,0,0,0,1,0,0]
							,"ior3: MDR = TOS = MDR OR H; wr; goto Main1","or") state 0 parte
	-- dup1: Incremento do SP e copia desse valor no MAR
	| x == 14 = microinstruc ([0,1,0,0],"",[1,0,0,1,0,0,0,0,0]
							,"dup1: MAR = SP = SP + 1","inc") state 15 parte
	-- dup2: Incremento do SP e copia desse valor no MAR
	| x == 15 = microinstruc ([0,1,1,1],"write",[0,1,0,0,0,0,0,0,0]
							,"dup2: MDR = TOS; wr; goto Main1"," B") state 0 parte
	-- pop1: Leitura do valor a ser colocado no topo da pilha
	| x == 16 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"pop1: MAR = SP = SP - 1; rd","dec") state 17 parte
	-- pop2: Espera pela leitura do novo valor de TOS
	| x == 17 = microinstruc ([1,1,1,1],"",[0,0,0,0,0,0,0,0,0]
							,"pop2: Nada","") state 18 parte
	-- pop3: Copia em TOS do novo valor
	| x == 18 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"pop3: TOS = MDR; goto Main1"," B") state 0 parte
	-- swap1: Coloca no MAR o valor de SP - 1; le a segunda palavra da pilha (a partir do topo)
	| x == 19 = microinstruc ([0,1,0,0],"read",[1,0,0,0,0,0,0,0,0]
							,"swap1: MAR = SP - 1; rd","dec") state 20 parte
	-- swap2: Coloca no MAR o endereco da palavra do topo da pilha
	| x == 20 = microinstruc ([0,1,0,0],"",[1,0,0,0,0,0,0,0,0]
							,"swap2: MAR = SP"," B") state 21 parte
	-- swap3: Salva o valor de TOS em H; escreva a segunda palavra no topo da pilha
	| x == 21 = microinstruc ([0,0,0,0],"write",[0,0,0,0,0,0,0,0,1]
							,"swap3: H = MDR; wr"," B") state 22 parte
	-- swap4: Copia no MDR o valor anterior de TOS
	| x == 22 = microinstruc ([0,1,1,1],"",[0,1,0,0,0,0,0,0,0]
							,"swap4: MDR = TOS"," B") state 23 parte
	-- swap5: Atribui o valor SP - 1 a MAR; passa a segunda palavra da pilha para o topo
	| x == 23 = microinstruc ([0,1,0,0],"write",[1,0,0,0,0,0,0,0,0]
							,"swap5: MAR = SP - 1; wr","dec") state 24 parte
	-- swap6: Atualiza o valor de TOS
	| x == 24 = microinstruc ([1,1,1,1],"",[0,0,0,0,0,0,1,0,0]
							,"swap6: TOS = H; goto Main1"," H") state 0 parte
	-- bipush1: MBR = byte a ser colocado na pilha
	| x == 25 = microinstruc ([0,1,0,0],"",[1,0,0,1,0,0,0,0,0]
							,"bipush1: SP = MAR = SP + 1","inc") state 26 parte
	-- bipush2: Incremento do PC; busca do proximo codigo de operacao
	| x == 26 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"bipush2: PC = PC + 1; fetch","inc") state 27 parte
	-- bipush3: Estende o sinal da constante e coloca na pilha
	| x == 27 = microinstruc ([0,0,1,0],"write",[0,1,0,0,0,0,1,0,0]
							,"bipush3: MDR = TOS = MBR; wr; goto Main1"," B") state 0 parte
	-- iload1: MBR contem o indice; copia de LV em H
	| x == 28 = microinstruc ([0,1,0,1],"",[0,0,0,0,0,0,0,0,1]
							,"iload1: H = LV"," B") state 29 parte
	-- iload2: MAR = endereco da variavel local que vai para a pilha
	| x == 29 = microinstruc ([0,0,1,1],"read",[1,0,0,0,0,0,0,0,0]
							,"iload2: MAR = MBRU + H; rd","add") state 30 parte
	-- iload3: SP aponta para o novo topo da pilha; prepara escrita
	| x == 30 = microinstruc ([0,1,0,0],"",[1,0,0,0,0,0,0,0,0]
							,"iload3: MAR = SP = SP + 1","inc") state 31 parte
	-- iload4: Incrementa o PC; obtem o proximo codigo de operacao; escreve no topo da pilha
	| x == 31 = microinstruc ([0,0,0,1],"fetchwrite",[0,0,1,0,0,0,0,0,0]
							,"iload4: PC = PC + 1; fetch; wr","inc") state 32 parte
	-- iload5: Atualiza o valor de TOS
	| x == 32 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"iload5: TOS = MDR; goto Main1"," B") state 0 parte
	-- istore1: MBR contem o indice; copia de LV em H
	| x == 33 = microinstruc ([0,1,0,1],"",[0,0,0,0,0,0,0,0,1]
							,"istore1: H = LV"," B") state 34 parte
	-- istore2: MAR = endereco da variavel local que vai para a pilha
	| x == 34 = microinstruc ([0,0,1,1],"",[1,0,0,0,0,0,0,0,0]
							,"istore2: MAR = MBRU + H","add") state 35 parte
	-- istore3: Copia de TOS no MDR; escrita da palavra
	| x == 35 = microinstruc ([0,1,1,1],"write",[0,1,0,0,0,0,0,0,0]
							,"istore3: MDR = TOS; wr"," B") state 36 parte
	-- istore4: Leitura do valor a ser colocado no topo da pilha
	| x == 36 = microinstruc ([0,1,0,0],"read",[1,0,0,0,0,0,0,0,0]
							,"istore4: MAR = SP = SP - 1; rd","dec") state 37 parte
	-- istore5: Incremento do PC; busca do proximo codigo de operacao
	| x == 37 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"istore5: PC = PC + 1; fetch","inc") state 38 parte
	-- istore6: Atualiza o valor de TOS
	| x == 38 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"istore6: TOS = MDR; goto Main1"," B") state 0 parte
	-- wide1: Desvio condicional com bit de mais alta ordem igual a 1
	| x == 39 = do
				mbr' <- get (mbr state)
				microinstruc ([0,0,0,1],"",[0,0,1,0,0,0,0,0,0]
					,"wide1: PC = PC + 1; fetch; goto(MBR OR 0x100)","inc") state (mbrOR100 mbr') parte
	-- ldc_w1: MBR contem o primeiro byte do indice; busca do segundo byte
	| x == 40 =  microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"ldc_w1: PC = PC + 1; fetch","inc") state 41 parte
	-- ldc_w2: H = primeiro byte do indice deslocado 8 bits para a esquerda
	| x == 41 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"ldc_w2: H = MBRU << 8","desl") state 42 parte
	-- ldc_w3: H = indice de 16 bits para a area de variaveis locais
	| x == 42 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"ldc_w3: H = MBRU OR H","or") state 43 parte
	-- ldc_w4: MAR = endereco no pool de constantes
	| x == 43 = microinstruc ([0,0,1,1],"read",[1,0,0,0,0,0,0,0,0]
							,"ldc_w4: MAR = H + CPP; rd; goto iload3","add") state 30 parte
	-- iinc1: MBR contem o indice; copia do conteudo de LV em H
	| x == 44 = microinstruc ([0,1,0,1],"",[0,0,0,0,0,0,0,0,1]
							,"iinc1: H = LV"," B") state 45 parte
	-- iinc2: copia de LV + indice do MAR; leitura da variavel
	| x == 45 = microinstruc ([0,0,1,1],"read",[1,0,0,0,0,0,0,0,0]
							,"iinc2: MAR = MBRU + H; rd","add") state 46 parte
	-- iinc3: busca da constante
	| x == 46 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"iinc3: PC = PC + 1; fetch","inc") state 47 parte
	-- iinc4: copia do valor da variavel em H
	| x == 47 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,0,0,1]
							,"iinc4: H = MDR"," B") state 48 parte
	-- iinc5: busca do proximo codigo de operacao
	| x == 48 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"iinc5: PC = PC + 1; fetch","inc") state 49 parte
	-- iinc6: coloca soma MBR + H no MDR; atualiza valor da variavel
	| x == 49 = microinstruc ([0,0,1,0],"write",[0,1,0,0,0,0,0,0,0]
							,"iinc6: MDR = MBR + H; wr; goto Main1","add") state 0 parte
	-- goto1: guarda o valor do codigo de operacao no registrador OPC
	| x == 50 = microinstruc ([0,0,0,1],"",[0,0,0,0,0,0,0,1,0]
							,"goto1: OPC = PC - 1","dec") state 51 parte
	-- goto2: MBR = primeiro byte do deslocamento; busca do segundo byte
	| x == 51 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"goto2: PC = PC + 1; fetch","inc") state 52 parte
	-- goto3: deslocamento e armazenamento em H do primeiro byte considerando o sinal
	| x == 52 = microinstruc ([0,0,1,0],"",[0,0,0,0,0,0,0,0,1]
							,"goto3: H = MBR << 8","desl") state 53 parte
	-- goto4: H = deslocamento de 16 bits do desvio
	| x == 53 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"goto4: H = MBRU OR H","or") state 54 parte
	-- goto5: soma do deslocamento ao valor em OPC
	| x == 54 = do
				h' <- get (h state)
				opc' <- get (opc state)
				if (parte == 1) then atualizaInstr h' state else return ()
				microinstruc ([1,0,0,0],"fetch",[0,0,1,0,0,0,0,0,0]
							,"goto5: PC = OPC + H; fetch","add") state 55 parte
	-- goto6: agurada a busca do proximo codigo de operacao
	| x == 55 = microinstruc ([1,1,1,1],"",[0,0,0,0,0,0,0,0,0]
							,"goto6: goto Main1","") state 0 parte
	-- iflt1: leitura do valor a ser colocado no topo da pilha
	| x == 56 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"iflt1: MAR = SP = SP - 1; rd","dec") state 57 parte
	-- iflt2: armazenamento temporario do valor de TOS em OPC
	| x == 57 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,1,0]
							,"iflt2: OPC = TOS"," B") state 58 parte
	-- iflt3: coloca o novo valor do topo da pilha em TOS
	| x == 58 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"iflt3: TOS = MDR"," B") state 59 parte
	-- iflt4: desvio condicional considerando o bit N
	| x == 59 = do
				n' <- get (opc state)				
				microinstruc ([1,0,0,0],"",[0,0,0,0,0,0,0,0,0]
							,"iflt4: N = OPC; if (N) goto T; else goto F"," B") state 
							(if (n' < 0) then 70 else 71)	parte
	-- ifeq1: leitura do valor a ser colocado no topo da pilha
	| x == 60 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"ifeq1: MAR = SP = SP - 1; rd","dec") state 61 parte
	-- ifeq2: armazenamento temporario do valor de TOS em OPC
	| x == 61 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,0,1,0]
							,"ifeq2: OPC = TOS"," B") state 62 parte
	-- ifeq3: coloca o novo valor do topo da pilha em TOS
	| x == 62 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"ifeqt3: TOS = MDR"," B") state 63 parte
	-- ifeq4: desvio condicional considerando o bit N
	| x == 63 = do
				z' <- get (opc state)
				h' <- get (h state)
				microinstruc ([1,0,0,0],"",[0,0,0,0,0,0,0,0,0]
							,"ifeq4: Z = OPC - H; if (Z) goto T; else goto F"," B") state 
							(if ((z' - h') == 0) then 70 else 71) parte
	-- if_icmpeq1: leitura do valor a ser colocado no topo da pilha
	| x == 64 = microinstruc ([0,1,0,0],"read",[1,0,0,1,0,0,0,0,0]
							,"if_icmpeq1: MAR = SP = SP - 1; rd","dec") state 65 parte
	-- if_icmpeq2: prepara o MAR para a leitura do novo topo da pilha
	| x == 65 = microinstruc ([0,1,0,0],"",[1,0,0,1,0,0,0,0,0]
							,"if_icmpeq2: MAR = SP = SP - 1","dec") state 66 parte
	-- if_icmpeq3: copia da segunda palavra da pilha em H
	| x == 66 = microinstruc ([0,0,0,0],"read",[0,0,0,0,0,0,0,0,1]
							,"if_icmpeq3: H = MDR; rd"," B") state 67 parte
	-- if_icmpeq4: armazenamento temporario do valor de TOS em OPC
	| x == 67 = microinstruc ([0,1,1,1],"",[0,0,0,0,0,0,1,0,0]
							,"if_icmpeq4: OPC = TOS"," B") state 68 parte
	-- if_icmpeq5: coloca o novo valor do topo da pilha em TOS
	| x == 68 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"if_icmpeq5: TOS = MDR"," B") state 69 parte
	-- if_icmpeq6: se as duas palavras do topo da pilha forem iguais, desvia para T; se nao desvia para F
	| x == 69 = do
				z' <- get (opc state)
				h' <- get (h state)
				microinstruc ([1,0,0,0],"",[0,0,0,0,0,0,0,0,0]
							,"if_icmpeq6: Z = OPC - H; if (Z) goto T; else goto F","dec") state
							(if ((z' - h') == 0) then 70 else 71) parte
	-- T: mesma coisa que em goto1; necessario para tratar do endereco alvo
	| x == 70 = microinstruc ([0,0,0,1],"fetch",[0,0,0,0,0,0,0,1,0]
							,"T: OPC = PC - 1; fetch; goto goto2","dec") state 51 parte
	-- F: pula o primeiro byte do deslocamento
	| x == 71 = microinstruc ([0,0,0,1],"",[0,0,1,0,0,0,0,0,0]
							,"T: PC = PC + 1","inc") state 72 parte
	-- F2: PC agora aponta para o novo codigo de operacao
	| x == 72 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"T2: PC = PC + 1; fetch","inc") state 73 parte
	-- F3: espera pela leitura do codigo de operacao
	| x == 73 = microinstruc ([1,1,1,1],"",[0,0,0,0,0,0,0,0,0]
							,"T3: goto Main1","inc") state 0 parte
	----------
	-- wide_istore1: MBR contem o primeiro byte do indice; busca do segundo byte
	| x == 101 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"wide_istore1: PC = PC + 1; fetch","inc") state 102 parte
	-- wide_istore2: H = primeiro byte do indice deslocado 8 bits para a esquerda
	| x == 102 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"wide_istore2: H = MBRU << 8","desl") state 103 parte
	-- wide_istore3: H = indice de 16 bits para a area de variaveis locais
	| x == 103 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"wide_istore3: H = MBRU OR H","or") state 104 parte
	-- wide_istore4: MAR = endereco da variavel local a ser colocada na pilha
	| x == 104 = microinstruc ([0,1,0,1],"",[1,0,0,0,0,0,0,0,0]
							,"wide_istore4: MAR = LV + H; goto istore3","add") state 35 parte
	-- wide_iload1: MBR contem o primeiro byte do indice; busca do segundo byte
	| x == 124 =  microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"wide_iload1: PC = PC + 1; fetch","inc") state 125 parte
	-- wide_iload2: H = primeiro byte do indice deslocado 8 bits para a esquerda
	| x == 125 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"wide_iload2: H = MBRU << 8","desl") state 126 parte
	-- wide_iload3: H = indice de 16 bits para a area de variaveis locais
	| x == 126 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"wide_iload3: H = MBRU OR H","or") state 127 parte
	-- wide_iload4: MAR = endereco da variavel local a ser armazenada na area de variaveis locais
	| x == 127 = microinstruc ([0,1,0,1],"",[1,0,0,0,0,0,0,0,0]
							,"wide_istore4: MAR = LV + H; goto iload3","add") state 30 parte
	----------
	-- invokevirtual1: MBR = Indice do primeiro byte; PC recebe o endereco do segundo byte
	| x == 130 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual1: PC = PC + 1; fetch","inc") state 131 parte
	-- invokevirtual2: Descloca e guarda o primeiro byte em H
	| x == 131 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual2: H = MBRU << 8","desl") state 132 parte
	-- invokevirtual3: H = deslocamento do ponteiro para a area de procedimento a partir de CPP
	| x == 132 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual3: H = MBRU OR H","or") state 133 parte
	-- invokevirtual4: Obem ponteiro para o procedimento da area apontada por CPP
	| x == 133 = microinstruc ([0,1,1,0],"read",[1,0,0,0,0,0,0,0,0]
							,"invokevirtual4: MAR = CPP + H; rd","add") state 134 parte
	-- invokevirtual5: Armazena valor do PC para retorno do procedimento temporariamente em OPC
	| x == 134 = microinstruc ([0,0,0,1],"",[0,0,0,0,0,0,0,1,0]
							,"invokevirtual5: OPC = PC + 1","inc") state 135 parte
	-- invokevirtual6: PC aponta para o novo procedimento; busca da quantidade de parametros
	| x == 135 = microinstruc ([0,0,0,0],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual6: PC = MDR; fetch"," B") state 136 parte
	-- invokevirtual7: Busca do segundo byte da quantidade de parametros
	| x == 136 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual7: PC = PC + 1; fetch","inc") state 137 parte
	-- invokevirtual8: Desloca e guarda o primeiro byte em H
	| x == 137 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual8: H = MBRU << 8","desl") state 138 parte
	-- invokevirtual9: H contem o numero de parametros do procedimento
	| x == 138 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual9: H = MBRU OR H","or") state 139 parte
	-- invokevirtual10: Busca do primeiro byte do numero de variaveis locais
	| x == 139 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual10: PC = PC + 1; fetch","inc") state 140 parte
	-- invokevirtual11: TOS = endereco de OBJREF - 1
	| x == 140 = microinstruc ([0,1,0,0],"",[0,0,0,0,0,0,1,0,0]
							,"invokevirtual11: TOS = SP - H","sub") state 141 parte
	-- invokevirtual12: TOS = endereco de OBJREF (novo LV)	
	| x == 141 = microinstruc ([0,1,0,0],"",[1,0,0,0,0,0,1,0,0]
							,"invokevirtual12: TOS = MAR = TOS + 1","inc") state 142 parte
	-- invokevirtual13: Busca do segundo byte do numero de variaveis locais
	| x == 142 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual13: PC = PC + 1; fetch","inc") state 143 parte
	-- invokevirtual14: Desloca e guarda o segundo byte em H
	| x == 143 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual14: H = MBRU << 8","desl") state 144 parte
	-- invokevirtual15: H contem o numero de variaveis locais do procedimento
	| x == 144 = microinstruc ([0,0,1,1],"",[0,0,0,0,0,0,0,0,1]
							,"invokevirtual15: H = MBRU OR H","or") state 145 parte
	-- invokevirtual16: Escreve o valor do ponteiro de ligacao no lugar de OBJREF
	| x == 145 = microinstruc ([0,1,0,0],"write",[0,1,0,0,0,0,0,0,0]
							,"invokevirtual16: MDR = SP + H + 1; wr","ad+1") state 146 parte
	-- invokevirtual17: Atualiza SP e MAR
	| x == 146 = microinstruc ([0,0,0,0],"",[1,0,0,1,0,0,0,0,0]
							,"invokevirtual17: MAR = SP = MDR"," B") state 147 parte
	-- invokevirtual18: Salva o PC antigo em cima da area de variaveis locais
	| x == 147 = microinstruc ([1,0,0,0],"write",[1,0,0,0,0,0,0,0,0]
							,"invokevirtual18: MAR = OPC; wr"," B") state 148 parte
	-- invokevirtual19: SP aponta para a localizacao para onde vai o LV antigo
	| x == 148 = microinstruc ([0,1,0,0],"",[1,0,0,1,0,0,0,0,0]
							,"invokevirtual19: MAR = SP = SP + 1","inc") state 149 parte
	-- invokevirtual20: Salva o LV antigo em cima do PC
	| x == 149 = microinstruc ([0,1,0,1],"write",[0,1,0,0,0,0,0,0,0]
							,"invokevirtual20: MDR = LV; wr"," B") state 150 parte
	-- invokevirtual21: Busca do codigo de operacao da primeira instrucao do novo procedimento
	| x == 150 = microinstruc ([0,0,0,1],"fetch",[0,0,1,0,0,0,0,0,0]
							,"invokevirtual21: PC = PC + 1; fetch","inc") state 151 parte
	-- invokevirtual22: Faz LV apontar para o novo quadro de variaveis locais
	| x == 151 = microinstruc ([0,1,1,1],"",[0,0,0,0,1,0,0,0,0]
							,"invokevirtual22: LV = TOS; gotoMain1"," B") state 0 parte
	-----------------
	-- ireturn1: Guarda o ponteiro de retorno em SP e no MAR
	| x == 152 = microinstruc ([0,1,0,1],"read",[1,0,0,1,0,0,0,0,0]
							,"ireturn1: MAR = SP = LV; rd"," B") state 153 parte
	-- ireturn2: Aguarda termino da leitura
	| x == 153 = microinstruc ([0,0,0,0],"",[0,0,0,0,0,0,0,0,0]
							,"ireturn2: Nada","") state 154 parte
	-- ireturn3: Faz com que LV receba o ponteiro de ligacao; obtem o valor do PC antigo
	| x == 154 = microinstruc ([0,0,0,0],"read",[1,0,0,0,1,0,0,0,0]
							,"ireturn3: LV = MAR = MDR; rd"," B") state 155 parte
	-- ireturn4: Prepara MAR para a leitura do valor antigo de LV
	| x == 155 = microinstruc ([0,1,0,1],"",[1,0,0,0,0,0,0,0,0]
							,"ireturn4: MAR = LV + 1","inc") state 156 parte
	-- ireturn5: Restaura o valor do PC; busca do proximo codigo de operacao
	| x == 156 = microinstruc ([0,0,0,0],"readfetch",[0,0,1,0,0,0,0,0,0]
							,"ireturn5: PC = MDR; rd; fetch"," B") state 157 parte
	-- ireturn6: Prepara MAR para escrita em TOS
	| x == 157 = microinstruc ([0,1,0,0],"",[1,0,0,0,0,0,0,0,0]
							,"ireturn6: MAR = SP"," B") state 158 parte
	-- ireturn7: Restaura LV
	| x == 158 = microinstruc ([0,0,0,0],"",[0,0,0,0,1,0,0,0,0]
							,"ireturn7: LV = MDR"," B") state 159 parte
	-- ireturn8: Guarda o endereco de retorno no topo da pilha original
	| x == 159 = microinstruc ([0,1,1,1],"write",[0,0,0,0,0,0,0,0,0]
							,"ireturn8: MDR = TOS; wr; goto Main1"," B") state 0 parte
	| otherwise = return ()

decoder4x16 :: [Int] -> [Int]
decoder4x16 (a:b:c:d:[]) =
	-- B: MDR PC MBR1 MBR2 SP LV CPP TOS OPC
	-- C: MAR MDR PC SP LV CPP TOS OPC H
	(1 - a)*(1 - b)*(1 - c)*(1 - d): 	-- a'b'c'd' -> 1000000000000000
	(1 - a)*(1 - b)*(1 - c)*d:			-- a'b'c'd  -> 0100000000000000
	(1 - a)*(1 - b)*c*(1 - d):			-- a'b'c d' -> 0010000000000000
	(1 - a)*(1 - b)*c*d:				-- a'b'c d  -> 0001000000000000
	(1 - a)*b*(1 - c)*(1 - d):			-- a'b c'd' -> 0000100000000000
	(1 - a)*b*(1 - c)*d:				-- a'b c'd  -> 0000010000000000
	(1 - a)*b*c*(1 - d):				-- a'b c d' -> 0000001000000000
	(1 - a)*b*c*d:						-- a'b c d  -> 0000000100000000
	a*(1 - b)*(1 - c)*(1 - d):			-- a b'c'd' -> 0000000010000000
	a*(1 - b)*(1 - c)*d:				-- a b'c'd  -> 0000000001000000
	a*(1 - b)*c*(1 - d):				-- a b'c d' -> 0000000000100000
	a*(1 - b)*c*d:						-- a b'c d  -> 0000000000010000
	a*b*(1 - c)*(1 - d):				-- a b c'd' -> 0000000000001000
	a*b*(1 - c)*d:						-- a b c'd  -> 0000000000000100
	a*b*c*(1 - d):						-- a b c d' -> 0000000000000010
	a*b*c*d:[]							-- a b c d  -> 0000000000000001

toInt32 :: Int -> [Int] -> Int
toInt32 32 _ = 0
toInt32 x (valor:y) = (valor*2^x) + toInt32 (x + 1) y

andB :: [Bool] -> [Bool] -> [Int]
andB [] [] = []
andB (a:x) (b:y) = (if (a && b) then 1 else 0) : andB x y

orB :: [Bool] -> [Bool] -> [Int]
orB [] [] = []
orB (a:x) (b:y) = (if (a || b) then 1 else 0) : orB x y

estendeSinal :: Int -> Int
estendeSinal x = toInt32 0 (estendeAux 0 (fromInt32 0 x))

estendeAux :: Int -> [Int] -> [Int]
estendeAux ini (a:x)
	| ini == 32 = []
	| ini >= 7 = a : estendeAux (ini + 1) (a:x)
	| otherwise = a : estendeAux (ini + 1) x

mbrOR100 :: Int -> Int
mbrOR100 valor = toInt32 0 (orB (map (== 1) (fromInt32 0 valor)) (map (== 1) (fromInt32 0 100)))

desloca8 :: Int -> [Int] -> [Int]
desloca8 0 lista = [0,0,0,0,0,0,0,0] ++ desloca8 1 lista
desloca8 24 (a:x) = [a]
desloca8 i (a:x) = a : desloca8 (i + 1) x

atualizaInstr :: Int -> State -> IO()
atualizaInstr 1 state = return()
atualizaInstr 0 state = return()
atualizaInstr (-1) state = return()
atualizaInstr posicao state
	| posicao < (-1) = do
				programa' <- get (programa state)
				progAnt'@(a:x) <- get (progAnt state)
				programa state $= a:programa'
				progAnt state $= x
				atualizaInstr (posicao + 1) state
	| posicao > 1 = do
				programa'@(a:x) <- get (programa state)
				progAnt' <- get (progAnt state)
				programa state $= x
				progAnt state $= progAnt' ++ [a]
				atualizaInstr (posicao - 1) state
	| otherwise = return ()